home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8410.arc / INSIDE.BAS < prev    next >
BASIC Source File  |  1986-09-14  |  7KB  |  183 lines
  1. 10   '  Program to print data in a Worksheet File
  2. 20   '        W. F. Sharpe, February 1984
  3. 30   '
  4. 40   ' Main Program
  5. 50        GOSUB 120 ' open file
  6. 60        RECORDTYPE% = 0 
  7. 70        WHILE RECORDTYPE% <> 1
  8. 80           GOSUB 210 ' read and process a record
  9. 90        WEND
  10. 100    END
  11. 110  '
  12. 120  ' Procedure to open the worksheet file
  13. 130        INPUT "Worksheet name: "; FLNAME$
  14. 140        FLNAME$=FLNAME$+".WKS"
  15. 150        OPEN FLNAME$ AS 1 LEN=128
  16. 160            FIELD #1, 128 AS BUFFER$
  17. 170        GET #1
  18. 180        POINTER% = 1
  19. 190    RETURN
  20. 200  '
  21. 210  ' Procedure to read and process a record
  22. 220          GOSUB 370 ' read record type and length
  23. 230  '    go to appropriate routine for processing
  24. 240         IF RECORDTYPE% =  0 GOTO 1010 ' header 
  25. 250         IF RECORDTYPE% =  6 GOTO 1120 ' range
  26. 260         IF RECORDTYPE% = 13 GOTO 1340 ' integer value
  27. 270         IF RECORDTYPE% = 14 GOTO 1430 ' double precision value
  28. 280         IF RECORDTYPE% = 15 GOTO 1540 ' character string (label)
  29. 290         IF RECORDTYPE% = 16 GOTO 1650 ' formula and value
  30. 300         IF RECORDTYPE% =  1 GOTO 1800 ' end of worksheet 
  31. 310  '    not a type to be processed -- read remaining portion 
  32. 320         FOR I%=1 TO RECORDLENGTH%
  33. 330              GOSUB 480 ' get the next byte
  34. 340         NEXT I%
  35. 350    RETURN
  36. 360  '
  37. 370  ' Procedure to get the type and length of the record
  38. 380  '    get record type 
  39. 390           GOSUB 480
  40. 400           GOSUB 480
  41. 410           RECORDTYPE% = CVI ( PREVIOUSBYTE$ + BYTE$ )
  42. 420  '    get record length
  43. 430           GOSUB 480
  44. 440           GOSUB 480
  45. 450           RECORDLENGTH% = CVI ( PREVIOUSBYTE$ + BYTE$ )
  46. 460    RETURN
  47. 470  '
  48. 480  ' Procedure to get the next byte
  49. 490       PREVIOUSBYTE$ = BYTE$              
  50. 500       BYTE$ = MID$(BUFFER$,POINTER%,1) 
  51. 510       POINTER% = POINTER% + 1     
  52. 520       IF (POINTER% <= 128) THEN RETURN 
  53. 530          GET #1     
  54. 540          POINTER% = 1
  55. 550    RETURN
  56. 560  '
  57. 570  ' Procedure to get format, row and column for a data record
  58. 580      GOSUB 480
  59. 590         FORMATBYTE$=BYTE$
  60. 600      GOSUB 480
  61. 610      GOSUB 480
  62. 620         COLUMN% = CVI ( PREVIOUSBYTE$ + BYTE$ )
  63. 630      GOSUB 480
  64. 640      GOSUB 480
  65. 650         ROW% = CVI ( PREVIOUSBYTE$ + BYTE$ )
  66. 660    RETURN   
  67. 670  '
  68. 680  ' Procedure to print cell location
  69. 690  '   convert column to alphabetic characters
  70. 700       CHAR1% = COLUMN% \ 26
  71. 710       CHAR2% = COLUMN% MOD 26
  72. 720       IF CHAR1% = 0 THEN ALPHA$ = " " ELSE ALPHA$ = CHR$(64+CHAR1%)
  73. 730       ALPHA$ = ALPHA$ + CHR$(65+CHAR2%)
  74. 740  '   print column and row
  75. 750       PRINT ALPHA$; ROW%+1; 
  76. 760    RETURN
  77. 770  '
  78. 780  ' Procedure to convert double precision number 
  79. 790  '  test for NA code
  80. 800      IF ((BYT%(1)=255) AND (BYT%(2)=240)) THEN ISNA%=1 ELSE ISNA%=0
  81. 810      IF ISNA% = 1 THEN RETURN
  82. 820  '  test for zero
  83. 830      IF (BYT%(1)=0) AND (BYT%(2)=0) THEN DOUBLE#=0!: RETURN
  84. 840  '  get sign
  85. 850      IF ((BYT%(1) AND 128) >0) THEN SIGN%=-1 ELSE SIGN%=1
  86. 860  '  get exponent
  87. 870      BYT%(1) = BYT%(1) AND 127
  88. 880      BYT2LEFT% = (BYT%(2) AND 240)\16
  89. 890      BYT2RIGHT% = BYT%(2) AND 15
  90. 900      EXPONENT% = BYT%(1)*16 + BYT2LEFT% - 1023
  91. 910  '  get mantissa
  92. 920      SUM# = 0
  93. 930      FOR I% = 8 TO 3 STEP -1
  94. 940          SUM# = ( SUM# + BYT%(I%) ) / 256
  95. 950      NEXT I%
  96. 960      SIGNIFICAND# = 1 + (BYT2RIGHT%/16) + (SUM#/16)
  97. 970  '  compute value
  98. 980      DOUBLE# = SIGN% * (SIGNIFICAND# * (2^EXPONENT%))
  99. 990    RETURN
  100. 1000 '
  101. 1010 ' Procedure to process a header record (type 0)
  102. 1020     IF RECORDLENGTH% <> 2 THEN GOTO 1090
  103. 1030        GOSUB 480
  104. 1040           IF BYTE$ <> CHR$(4) THEN GOTO 1090
  105. 1050        GOSUB 480
  106. 1060           IF BYTE$ <> CHR$(4) THEN GOTO 1090
  107. 1070   RETURN
  108. 1080 ' error -- halt processing  
  109. 1090     PRINT "ERROR -- Not a Valid Worksheet File"
  110. 1100     END
  111. 1110 '
  112. 1120 ' Procedure to process a range record (type 6)
  113. 1130 '  find range from which data were saved
  114. 1140        GOSUB 480
  115. 1150        GOSUB 480
  116. 1160           FROMCOL% = CVI ( PREVIOUSBYTE$ + BYTE$)
  117. 1170        GOSUB 480
  118. 1180        GOSUB 480
  119. 1190           FROMROW% = CVI ( PREVIOUSBYTE$ + BYTE$)
  120. 1200        GOSUB 480
  121. 1210        GOSUB 480
  122. 1220           TOCOL% = CVI ( PREVIOUSBYTE$ + BYTE$)
  123. 1230        GOSUB 480
  124. 1240        GOSUB 480
  125. 1250           TOROW% = CVI ( PREVIOUSBYTE$ + BYTE$)
  126. 1260 '  find lower right corner
  127. 1270        ROW% = TOROW% - FROMROW%
  128. 1280        COLUMN% = TOCOL% - FROMCOL%
  129. 1290     PRINT "Lower Right Corner: ";
  130. 1300     GOSUB 680 ' print cell location
  131. 1310     PRINT
  132. 1320   RETURN
  133. 1330 ' 
  134. 1340 ' Procedure to process an integer record (type 13)
  135. 1350     GOSUB 570 ' get format, row and column
  136. 1360     GOSUB 680 ' print cell location
  137. 1370       GOSUB 480
  138. 1380       GOSUB 480
  139. 1390          VALUE% = CVI ( PREVIOUSBYTE$ + BYTE$ )
  140. 1400     PRINT TAB(9); VALUE%
  141. 1410   RETURN
  142. 1420 '
  143. 1430 ' Procedure to process a double precision value record (type 14)
  144. 1440     GOSUB 570 ' get format, row and column
  145. 1450     GOSUB 680 ' print cell location
  146. 1460     FOR I% = 1 TO 8
  147. 1470         GOSUB 480
  148. 1480         BYT%(9-I%) = ASC ( BYTE$ )
  149. 1490     NEXT I%
  150. 1500     GOSUB 780 ' convert to double-precision number
  151. 1510     IF ISNA% = 1 THEN PRINT TAB(9); "NA" ELSE PRINT TAB(9); DOUBLE#
  152. 1520   RETURN
  153. 1530 '
  154. 1540 ' Procedure to process a character string record (type 15)
  155. 1550     GOSUB 570 ' get format, row and column
  156. 1560     GOSUB 680 ' print cell location
  157. 1570     CHARSTRING$ = ""
  158. 1580     FOR I% = 1 TO (RECORDLENGTH% - 5)
  159. 1590         GOSUB 480
  160. 1600         CHARSTRING$ = CHARSTRING$ + BYTE$
  161. 1610     NEXT I%
  162. 1620     PRINT TAB(9); CHARSTRING$
  163. 1630   RETURN
  164. 1640 '
  165. 1650 ' Procedure to process a formula record (type 16)
  166. 1660     GOSUB 570 ' get format, row and column
  167. 1670     GOSUB 680 ' print cell location
  168. 1680     FOR I% = 1 TO 8
  169. 1690         GOSUB 480
  170. 1700         BYT%(9-I%) = ASC ( BYTE$ )
  171. 1710     NEXT I%
  172. 1720     GOSUB 780 ' convert to double-precision number
  173. 1730     IF ISNA% = 1 THEN PRINT TAB(9); "NA" ELSE PRINT TAB(9); DOUBLE#
  174. 1740 ' read past formula bytes 
  175. 1750     FOR I% = 1 TO (RECORDLENGTH% - 13)
  176. 1760          GOSUB 480
  177. 1770     NEXT I%
  178. 1780   RETURN
  179. 1790 '
  180. 1800 ' Procedure to process an end-of-worksheet record (type 1)
  181. 1810     PRINT "End of Worksheet File"
  182. 1820   RETURN
  183.